home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 3 / Gold Medal Software - Volume 3 (Gold Medal) (1994).iso / prog / dnalib59.arj / LOTUS.BAS < prev    next >
BASIC Source File  |  1994-02-14  |  8KB  |  348 lines
  1. DECLARE SUB Browse(FileName$,Mouse%,TextColor%,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,Shadow%,Border%)
  2. DECLARE SUB CalcByte(Attr%,LowByte%,HiByte%)
  3. DECLARE SUB Clicked(Rgt%,Lft%,Row%,Col%)
  4. DECLARE SUB HideCursor()
  5. DECLARE SUB ShowCursor()
  6. DECLARE SUB SplitPath(FilePath$, Path$, FileName$)
  7. DECLARE FUNCTION LeftButtonReleased%()
  8. DECLARE FUNCTION GetProgramName$()
  9. DECLARE FUNCTION GetPSP%()
  10.  
  11. SUB Lotus(Choices$(),Infoline$(),HiLight%,Mouse%,LPointer%,HotKey%,HelpTextColor%,HelpAttr%,BarAttr%,HiAttr%,MenuRow%,Gap%) PUBLIC
  12.  
  13. CalcByte HiAttr%,HiFG%,HiBG%
  14. CalcByte BarAttr%,BarFG%,BarBG%
  15.  
  16. SplitPath GetProgramName$,Home$,EXEName$
  17.  
  18. 'first we initialize these to zero
  19.  
  20. i% = 0
  21. j% = 0
  22. Maxlength% = 0
  23.  
  24. 'next we count the choices and set the result to count%
  25.  
  26. DO
  27.  
  28. INCR i%
  29. INCR j%
  30.  
  31. IF LEN(Choices$(i%)) = 0 THEN
  32.   DECR i%
  33. ELSE
  34.   Fixedup$ = REMOVE$(Choices$(i%),"@")
  35.   Maxlength% = Maxlength% + LEN(Fixedup$)
  36. END IF
  37.  
  38. LOOP WHILE i% = j%
  39.  
  40. Count% = i%
  41.  
  42. DIM Position%(1 TO Count%)
  43.  
  44. 'here we do a bit of checking to see if the menu bar will fit
  45.  
  46. IF Maxlength% + ((Gap% * Count%) + Gap%) > 80 THEN
  47.   COLOR 0,7
  48.   LOCATE 12,27,0
  49.   PRINT "Horizontal Menu is too big";
  50.   EXIT SUB
  51. END IF
  52.  
  53.  
  54. IF LPointer% = -1 THEN
  55.   LOCATE MenuRow%,1,0
  56.   COLOR BarFG%,BarBG%
  57.   PRINT SPACE$(80);
  58.   Pointer% = 0
  59.   LPointer% = 0
  60.   SelectionMade% = 1
  61. ELSE
  62.   Pointer% = LPointer%
  63.   SelectionMade% = 0
  64. END IF
  65.  
  66. Jump:
  67.  
  68. DO
  69.  
  70. GOSUB PrintRoutine
  71.  
  72. IF SelectionMade% THEN
  73.   IF InfoLinePrinted% THEN
  74.     COLOR BarFG%,BarBG%
  75.     LOCATE MenuRow% + 1,1,0
  76.     PRINT SPACE$(80);
  77.   END IF
  78.   EXIT SUB
  79. END IF
  80.  
  81. WHILE NOT INSTAT
  82.   IF Mouse% THEN
  83.     Rgt% = 0:Lft% = 0:MRow% = 0:MCol% = 0
  84.     ShowCursor
  85.     Clicked Rgt%,Lft%,MRow%,MCol%
  86.     IF Lft% AND MRow% = MenuRow% THEN
  87.       FOR i% = 1 TO Count%
  88.         IF MCol% >= Position%(i%) AND MCol% < Position%(i%) + LEN(REMOVE$(Choices$(i%),"@")) THEN
  89.           Pointer% = i%
  90.           IF LeftButtonReleased THEN
  91.             SelectionMade% = 1
  92.             LPointer% = Pointer%
  93.             Pointer% = 0: HiLight% = 0
  94.           ELSE
  95.             SelectionMade% = 0
  96.           END IF
  97.           GOTO Jump
  98.         END IF
  99.       NEXT i%
  100.     ELSE
  101.       IF LeftButtonReleased THEN
  102.         SelectionMade% = 1
  103.         LPointer% = 0
  104.         Pointer% = 0: HiLight% = 0
  105.         GOTO Jump
  106.       END IF
  107.     END IF
  108.   END IF
  109. WEND
  110. Ky$ = INKEY$
  111.  
  112.  
  113. IF LEN(Ky$) = 1 THEN
  114.   Chose% = ASC(Ky$)
  115. ELSE
  116.   Chose% = -ASC(RIGHT$(Ky$,1))
  117. END IF
  118.  
  119. SELECT CASE Chose%
  120.   CASE -16
  121.     TestKey$ = "Q"
  122.     GOSUB AltKeys
  123.   CASE -17
  124.     TestKey$ = "W"
  125.     GOSUB AltKeys
  126.   CASE -18
  127.     TestKey$ = "E"
  128.     GOSUB AltKeys
  129.   CASE -19
  130.     TestKey$ = "R"
  131.     GOSUB AltKeys
  132.   CASE -20
  133.     TestKey$ = "T"
  134.     GOSUB AltKeys
  135.   CASE -21
  136.     TestKey$ = "Y"
  137.     GOSUB AltKeys
  138.   CASE -22
  139.     TestKey$ = "U"
  140.     GOSUB AltKeys
  141.   CASE -23
  142.     TestKey$ = "I"
  143.     GOSUB AltKeys
  144.   CASE -24
  145.     TestKey$ = "O"
  146.     GOSUB AltKeys
  147.   CASE -25
  148.     TestKey$ = "P"
  149.     GOSUB AltKeys
  150.   CASE -30
  151.     TestKey$ = "A"
  152.     GOSUB AltKeys
  153.   CASE -31
  154.     TestKey$ = "S"
  155.     GOSUB AltKeys
  156.   CASE -32
  157.     TestKey$ = "D"
  158.     GOSUB AltKeys
  159.   CASE -33
  160.     TestKey$ = "F"
  161.     GOSUB AltKeys
  162.   CASE -34
  163.     TestKey$ = "G"
  164.     GOSUB AltKeys
  165.   CASE -35
  166.     TestKey$ = "H"
  167.     GOSUB AltKeys
  168.   CASE -36
  169.     TestKey$ = "J"
  170.     GOSUB AltKeys
  171.   CASE -37
  172.     TestKey$ = "K"
  173.     GOSUB AltKeys
  174.   CASE -38
  175.     TestKey$ = "L"
  176.     GOSUB AltKeys
  177.   CASE -44
  178.     TestKey$ = "Z"
  179.     GOSUB AltKeys
  180.   CASE -45
  181.     TestKey$ = "X"
  182.     GOSUB AltKeys
  183.   CASE -46
  184.     TestKey$ = "C"
  185.     GOSUB AltKeys
  186.   CASE -47
  187.     TestKey$ = "V"
  188.     GOSUB AltKeys
  189.   CASE -48
  190.     TestKey$ = "B"
  191.     GOSUB AltKeys
  192.   CASE -49
  193.     TestKey$ = "N"
  194.     GOSUB AltKeys
  195.   CASE -50
  196.     TestKey$ = "M"
  197.     GOSUB AltKeys
  198.   CASE -59  ' F1 Help key
  199.     IF Pointer% > 0 THEN
  200.       IF LEN(REMOVE$(Choices$(Pointer%),ANY "@ ")) > 8 THEN
  201.         FileName$ = LEFT$(UCASE$(REMOVE$(Choices$(Pointer%),ANY "@ ")),8) + ".HLP"
  202.       ELSE
  203.         FileName$ = UCASE$(REMOVE$(Choices$(Pointer%),ANY "@ ")) + ".HLP"
  204.       END IF
  205.       BROWSE Home$ + FileName$,Mouse%,HelpTextColor%,7,16,18,64,HelpAttr%,1,1
  206.     END IF
  207.   CASE -75 'left arrow
  208.     IF Pointer% THEN
  209.       IF Pointer% > 1 THEN      'if Pointer is greater than Count
  210.         DECR Pointer%
  211.       ELSE
  212.         Pointer% = Count%
  213.       END IF
  214.     ELSE
  215.       Pointer% = Count%
  216.     END IF
  217.   CASE -77 'right arrow
  218.     IF Pointer% THEN
  219.       IF Pointer% < Count% THEN  'if Pointer is greater than Count
  220.         INCR Pointer%
  221.       ELSE
  222.         Pointer% = 1
  223.       END IF
  224.     ELSE
  225.       Pointer% = 1
  226.     END IF
  227.   CASE 13  'enter key
  228.     IF Pointer% THEN
  229.       SelectionMade% = 1
  230.       LPointer% = Pointer%
  231.       Pointer% = 0: HiLight% = 0
  232.       GOTO Jump
  233.     END IF
  234.   CASE 65 TO 90,97 TO 122
  235.     TestKey$ = UCASE$(Ky$)
  236.     GOSUB AltKeys
  237.   CASE 27  'Esc key
  238.     SelectionMade% = 1
  239.     LPointer% = 0
  240.     Pointer% = 0: HiLight% = 0
  241.     GOTO Jump
  242.   CASE ELSE
  243.     SelectionMade% = 1
  244.     LPointer% = 0
  245.     Pointer% = 0: HiLight% = 0
  246.     BEEP
  247.     GOTO Jump
  248. END SELECT
  249.  
  250. LOOP
  251.  
  252. EXIT SUB
  253. '----------------------------------------------------------------------------
  254. AltKeys:
  255.  
  256. LPointer% = 0
  257.  
  258. FOR m% = 1 TO Count%
  259.   IF INSTR(Choices$(m%),"@") > 0 THEN
  260.     HotKeyPos% = INSTR(Choices$(m%),"@")
  261.     HotKey$ = UCASE$(MID$(Choices$(m%),(HotKeyPos% + 1),1))
  262.     IF HotKey$ = TestKey$ THEN
  263.       LPointer% = m%
  264.       Pointer% = 0: HiLight% = 0
  265.       SelectionMade% = 1
  266.     END IF
  267.   END IF
  268. NEXT m%
  269.  
  270. IF LPointer% = 0 THEN
  271.   Pointer% = 0: HiLight% = 0
  272.   SelectionMade% = 1
  273.   BEEP
  274. END IF
  275.  
  276. RETURN
  277. '----------------------------------------------------------------------------
  278. PrintRoutine:
  279.  
  280. IF HiLight% THEN
  281.   OnOff% = Hotkey%
  282. ELSE
  283.   OnOff% = BarFG%
  284. END IF
  285.  
  286. IF Mouse% THEN HideCursor
  287.  
  288. FOR k% = 1 TO Count%             'this looks for the pointer
  289.   IF k% = Pointer% THEN          'and calculates the column
  290.     IF k% > 1 THEN               'to start printing the hi lite
  291.       Total% = 0
  292.       FOR l% = 1 TO (k% - 1)
  293.         INCR Total%,(Gap%)
  294.         Fixedup$ = REMOVE$(Choices$(l%),"@")
  295.         Total% = Total% + LEN(Fixedup$)
  296.       NEXT l%
  297.       Colpos% = Total% + (Gap% + 1)
  298.     ELSE
  299.       Colpos% = Gap% + 1
  300.     END IF
  301.     COLOR HiFG%,HiBG%
  302.     LOCATE MenuRow%,Colpos%,0
  303.     Position%(k%) = Colpos%
  304.     PRINT REMOVE$(Choices$(k%),"@");
  305.     IF LEN(Infoline$(k%)) > 0 THEN
  306.       IF SelectionMade% = 0 THEN
  307.         COLOR BarFG%,BarBG%
  308.         LOCATE MenuRow% + 1,1,0
  309.         PRINT SPACE$(80);
  310.         LOCATE MenuRow% + 1,Gap% + 1,0
  311.         PRINT Infoline$(k%);
  312.         InfoLinePrinted% = 1
  313.       END IF
  314.     END IF
  315.   ELSE
  316.     IF k% > 1 THEN                      'this determines the column
  317.       Total% = 0                        'position for printing the
  318.       FOR l% = 1 TO (k% - 1)            'rest of the menu
  319.         INCR Total%,(Gap%)
  320.         Fixedup$ = REMOVE$(Choices$(l%),"@")
  321.         Total% = Total% + LEN(Fixedup$)
  322.       NEXT l%
  323.       Colpos% = Total% + (Gap% + 1)
  324.     ELSE
  325.       Colpos% = Gap% + 1
  326.     END IF
  327.     LOCATE MenuRow%,Colpos%,0
  328.     Position%(k%) = Colpos%
  329.     IF INSTR(Choices$(k%),"@") > 0 THEN
  330.       HotKeyPos% = INSTR(Choices$(k%),"@")
  331.       Fixedup$ = REMOVE$(Choices$(k%),"@")
  332.       COLOR BarFG%,BarBG%
  333.       PRINT Fixedup$;
  334.       LOCATE MenuRow%,Colpos% + (HotKeyPos% - 1),0
  335.       COLOR OnOff%,BarBG%
  336.       HotKey$ = MID$(Choices$(k%),(HotKeyPos% + 1),1)
  337.       PRINT HotKey$;
  338.     ELSE
  339.       COLOR BarFG%,BarBG%
  340.       PRINT Choices$(k%);
  341.     END IF
  342.   END IF
  343. NEXT k%
  344.  
  345. RETURN
  346. '----------------------------------------------------------------------------
  347. END SUB
  348.